home *** CD-ROM | disk | FTP | other *** search
/ TestDrive Windows 1993 Fall / TestDrive Windows 1993 Fall.iso / dbase / samples / employee.frg < prev    next >
Encoding:
Text File  |  1993-03-09  |  6.2 KB  |  307 lines
  1. * Program............: employee.FRG
  2. * Date...............: 3-09-93
  3. * Versions...........: dBASE IV, Report 2.0
  4. *
  5. * Notes:
  6. * ------
  7. * Prior to running this procedure with the DO command
  8. * it is necessary use LOCATE because the CONTINUE
  9. * statement is in the main loop.
  10. *
  11. *-- Parameters
  12. PARAMETERS gl_noeject, gl_plain, gl_summary, gc_heading, gc_extra
  13. ** The first three parameters are of type Logical.
  14. ** The fourth parameter is a string.  The fifth is extra.
  15. PRIVATE _peject, _wrap, ll_heading
  16. ll_heading = .F.
  17.  
  18. *-- Test for no records found
  19. IF EOF() .OR. .NOT. FOUND()
  20.    RETURN
  21. ENDIF
  22.  
  23. *-- turn word wrap mode off
  24. _wrap=.F.
  25.  
  26. IF _plength < (_pspacing * 3 + 1) + (_pspacing + 1) + 2
  27.    SET DEVICE TO SCREEN
  28.    DEFINE WINDOW gw_report FROM 7,17 TO 11,62 DOUBLE
  29.    ACTIVATE WINDOW gw_report
  30.    @ 0,1 SAY "Increase the page length for this report."
  31.    @ 2,1 SAY "Press any key ..."
  32.    x=INKEY(0)
  33.    DEACTIVATE WINDOW gw_report
  34.    RELEASE WINDOW gw_report
  35.    RETURN
  36. ENDIF
  37.  
  38. _plineno=0          && set lines to zero
  39. *-- NOEJECT parameter
  40. IF gl_noeject
  41.    IF _peject="BEFORE"
  42.       _peject="NONE"
  43.    ENDIF
  44.    IF _peject="BOTH"
  45.       _peject="AFTER"
  46.    ENDIF
  47. ENDIF
  48.  
  49. *-- Set-up environment
  50. ON ESCAPE DO Prnabort
  51. IF SET("TALK")="ON"
  52.    SET TALK OFF
  53.    gc_talk="ON"
  54. ELSE
  55.    gc_talk="OFF"
  56. ENDIF
  57. gc_space=SET("SPACE")
  58. SET SPACE OFF
  59. gc_time=TIME()      && system time for predefined field
  60. gd_date=DATE()      && system date  "    "    "     "
  61. gl_fandl=.F.        && first and last page flag
  62. gl_prntflg=.T.      && Continue printing flag
  63. gl_widow=.T.        && flag for checking widow bands
  64. gn_length=LEN(gc_heading)  && store length of the HEADING
  65. gn_level=2          && current band being processed
  66. gn_page=_pageno     && grab current page number
  67. gn_pspace=_pspacing && get current print spacing
  68.  
  69.  
  70. *-- Set up procedure for page break
  71. gn_atline=_plength - (_pspacing + 1)
  72. ON PAGE AT LINE gn_atline EJECT PAGE
  73.  
  74. *-- Print Report
  75.  
  76. PRINTJOB
  77.  
  78. *-- Initialize summary variables.
  79. r_msum1=0
  80.  
  81. IF gl_plain
  82.    ON PAGE AT LINE gn_atline DO Pgplain
  83. ELSE
  84.    ON PAGE AT LINE gn_atline DO Pgfoot
  85. ENDIF
  86.  
  87. DO Pghead
  88.  
  89. gl_fandl=.T.        && first physical page started
  90.  
  91. DO Rintro
  92.  
  93. *-- File Loop
  94. DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
  95.    gn_level=0
  96.    *-- Detail lines
  97.    IF gl_summary
  98.       DO Upd_Vars
  99.    ELSE
  100.       DO __Detail
  101.    ENDIF
  102.    gl_widow=.T.         && enable widow checking
  103.    CONTINUE
  104. ENDDO
  105.  
  106. IF gl_prntflg
  107.    DO Rsumm
  108.    IF _plineno <= gn_atline
  109.       EJECT PAGE
  110.    ENDIF
  111. ELSE
  112.    DO Rsumm
  113.    DO Reset
  114.    RETURN
  115. ENDIF
  116.  
  117. ON PAGE
  118.  
  119. ENDPRINTJOB
  120.  
  121. DO Reset
  122. RETURN
  123. * EOP: employee.FRG
  124.  
  125. *-- Update summary fields and/or calculated fields.
  126. PROCEDURE Upd_Vars
  127. *-- Count
  128. r_msum1=r_msum1+1
  129. RETURN
  130. * EOP: Upd_Vars
  131.  
  132. *-- Set flag to get out of DO WHILE loop when escape is pressed.
  133. PROCEDURE Prnabort
  134. gl_prntflg=.F.
  135. RETURN
  136. * EOP: Prnabort
  137.  
  138. PROCEDURE Pghead
  139. PRIVATE ll_heading, ln_width
  140. ll_heading = .T.
  141. ln_width = _rmargin - _lmargin
  142. ?
  143. *-- Print HEADING parameter - if it doesn't fit on line one
  144. *-- Value added to gn_length is the last column on line one times two
  145. IF .NOT. gl_plain .AND. gn_length + 158 > ln_width
  146.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width))
  147.    ?
  148.    ll_heading = .F.
  149. ENDIF
  150.  
  151. ?? IIF(gl_plain,'',gd_date) AT 0,;
  152.  IIF(gl_plain,'' , "PAGE " ) AT 70,;
  153.  IIF(gl_plain,'',_pageno) PICTURE "999" 
  154.  
  155. *-- Print HEADING parameter - if it fits on line one
  156. IF .NOT. gl_plain .AND. gn_length > 0 .AND. ll_heading
  157.    ?? " "
  158.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width-(_pcolno*2)))
  159. ENDIF
  160. ?
  161. ?
  162. RETURN
  163. * EOP: Pghead
  164.  
  165. PROCEDURE Rintro
  166. DEFINE BOX FROM 23 TO 51 HEIGHT 4 DOUBLE
  167. ?
  168. ?? "A-T FURNITURE INDUSTRIES" AT 26
  169. ?
  170. ?? "EMPLOYEE REPORT" AT 30
  171. ?
  172. ?
  173. ?
  174. ?? ;
  175. "══════════════════════════════════════════════════════════════════════";
  176. + "══════════";
  177. AT 0
  178. ?
  179. RETURN
  180. * EOP: Rintro
  181.  
  182. PROCEDURE __Detail
  183. IF 11 * gn_pspace < gn_atline - (_pspacing * 3 + 1)
  184.    IF gl_widow .AND. _plineno+11 * gn_pspace > gn_atline + 1
  185.       EJECT PAGE
  186.    ENDIF
  187. ENDIF
  188. DO Upd_Vars
  189. ?
  190. ?? Lastname FUNCTION "T" AT 0,;
  191.  ", " ,;
  192.  Firstname FUNCTION "T" ,;
  193.  " " ,;
  194.  Initial FUNCTION "T" ,;
  195.  "." ,;
  196.  "ID:" AT 38,;
  197.  Emp_id FUNCTION "T" AT 42,
  198. ?? Phone FUNCTION "T" AT 57
  199. ?
  200. ?? Address1 FUNCTION "T" AT 0,;
  201.  " " ,;
  202.  Address2 FUNCTION "T" 
  203. ?
  204. ?? City FUNCTION "T" AT 0,;
  205.  ", " ,;
  206.  State FUNCTION "T" ,;
  207.  " " ,;
  208.  Zip FUNCTION "T" 
  209. ?
  210. ?? "DEPARTMENT:" AT 5,;
  211.  Department FUNCTION "T" AT 17,;
  212.  "SALARY:  $" AT 57,;
  213.  Salary PICTURE "99,999.99" AT 71
  214. ?
  215. ?? Title FUNCTION "T" AT 17,;
  216.  Specialty FUNCTION "T" AT 38,;
  217.  "COMMISSION RATE:  " AT 57,;
  218.  Rate PICTURE "99.9" ,;
  219.  "%" 
  220. ?
  221. ?? "DATE HIRED: " AT 5,;
  222.  Date_hired ,;
  223.  "DEGREE:" AT 38,;
  224.  Degree FUNCTION "T" AT 46,;
  225.  "YEARS EXPERIENCE: " AT 57,;
  226.  Yrs_exper PICTURE "99.9" 
  227. ?
  228. ?? "EXEMPT: " AT 5,;
  229.  Exempt PICTURE "Y" ,;
  230.  "FULLTIME:" AT 38,;
  231.  Full_time PICTURE "Y" AT 50
  232. ?
  233. ?? "AWARDS: " AT 5,;
  234.  Awards FUNCTION "T" ,;
  235.  "LABORGRADE:" AT 38,;
  236.  Laborgrade PICTURE "9" AT 50
  237. ?
  238. ?? "COMMENTS: " AT 5,;
  239.  Comments FUNCTION "T" 
  240. ?
  241. ?? ;
  242. "──────────────────────────────────────────────────────────────────────";
  243. + "──────────";
  244. AT 0
  245. ?
  246. RETURN
  247. * EOP: __Detail
  248.  
  249. PROCEDURE Rsumm
  250. ?
  251. ?
  252. ?? ;
  253. "──────────────────────────────────────────────────────────────────────";
  254. + "──────────";
  255. AT 0
  256. ?
  257. ?? "NUMBER OF EMPLOYEES:" AT 0,;
  258.  r_msum1 PICTURE "99,999" AT 21
  259. ?
  260. ?? ;
  261. "──────────────────────────────────────────────────────────────────────";
  262. + "──────────";
  263. AT 0
  264. gl_fandl=.F.        && last page finished
  265. ?
  266. RETURN
  267. * EOP: Rsumm
  268.  
  269. PROCEDURE Pgfoot
  270. PRIVATE _box, _pspacing
  271. gl_widow=.F.         && disable widow checking
  272. _pspacing=1
  273. ?
  274. IF .NOT. gl_plain
  275.    _pspacing=gn_pspace
  276. ENDIF
  277. EJECT PAGE
  278. *-- is the page number greater than the ending page
  279. IF _pageno > _pepage
  280.    GOTO BOTTOM
  281.    SKIP
  282.    gn_level=0
  283. ENDIF
  284. IF .NOT. gl_plain .AND. gl_fandl
  285.    _pspacing=gn_pspace
  286.    DO Pghead
  287. ENDIF
  288. RETURN
  289. * EOP: Pgfoot
  290.  
  291. *-- Process page break when PLAIN option is used.
  292. PROCEDURE Pgplain
  293. PRIVATE _box
  294. EJECT PAGE
  295. RETURN
  296. * EOP: Pgplain
  297.  
  298. *-- Reset dBASE environment prior to calling report
  299. PROCEDURE Reset
  300. SET SPACE &gc_space.
  301. SET TALK &gc_talk.
  302. ON ESCAPE
  303. ON PAGE
  304. RETURN
  305. * EOP: Reset
  306.  
  307.